home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / packages / emacsbug.el.z / emacsbug.el
Encoding:
Text File  |  1998-05-21  |  5.5 KB  |  166 lines
  1. ;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list.
  2.  
  3. ;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Author: K. Shane Hartman
  6. ;; Maintainer: FSF
  7. ;; Keywords: maint
  8.  
  9. ;; Not fully installed because it can work only on Internet hosts.
  10. ;; This file is part of XEmacs.
  11.  
  12. ;; XEmacs is free software; you can redistribute it and/or modify it
  13. ;; under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; XEmacs is distributed in the hope that it will be useful, but
  18. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20. ;; General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25. ;; 02111-1307, USA.
  26.  
  27. ;;; Synched up with: FSF 19.34.
  28.  
  29. ;;; Commentary:
  30.  
  31. ;; `M-x report-emacs-bug ' starts an email note to the Emacs maintainers
  32. ;; describing a problem.  Here's how it's done...
  33.  
  34. ;;; Code:
  35.  
  36. ;; >> This should be an address which is accessible to your machine,
  37. ;; >> otherwise you can't use this file.  It will only work on the
  38. ;; >> internet with this address.
  39.  
  40. (require 'sendmail)
  41.  
  42. ;; XEmacs:  Screen for whether a beta version is running and redirect
  43. ;; reports to the beta list instead of the newsgroup.
  44. (defvar report-emacs-bug-pretest-address "xemacs-beta@xemacs.org"
  45.   "Address of mailing list for XEmacs beta bugs.")
  46.  
  47. (defvar bug-gnu-emacs "xemacs@xemacs.org"
  48.   "Address of site maintaining mailing list for XEmacs bugs.")
  49.  
  50. (defvar report-emacs-bug-orig-text nil
  51.   "The automatically-created initial text of bug report.")
  52.  
  53. ;;;###autoload
  54. (defun report-xemacs-bug (topic)
  55.   "Report a bug in XEmacs.
  56. Prompts for bug subject.  Leaves you in a mail buffer."
  57.   (interactive "sBug Subject: ")
  58.   (if (mail nil
  59.         (if (string-match "\(beta[0-9]+\)" emacs-version)
  60.         ;; If there are four numbers in emacs-version,
  61.         ;; this is a pretest version.
  62.         report-emacs-bug-pretest-address
  63.           bug-gnu-emacs)
  64.         topic)
  65.       (let (user-point)
  66.     ;; The rest of this does not execute
  67.     ;; if the user was asked to confirm and said no.
  68.     (goto-char (point-min))
  69.     (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n"))
  70.     (insert "In " (emacs-version) "\n")
  71.     (if (and system-configuration-options
  72.          (not (equal system-configuration-options "")))
  73.         (insert "configured using `configure "
  74.             system-configuration-options "'\n"))
  75.     (insert "\n")
  76.     (insert "Please describe exactly what actions triggered the bug\n"
  77.         "and the precise symptoms of the bug:\n\n") 
  78.     (setq user-point (point))
  79.     (insert "\n\n\n"
  80.         "Recent input:\n")
  81.     (let ((before-keys (point)))
  82.       ;; XEmacs:
  83.       (insert (key-description (recent-keys)))
  84. ;      (insert (mapconcat (lambda (key)
  85. ;                   (if (or (integerp key)
  86. ;                       (symbolp key)
  87. ;                       (listp key))
  88. ;                   (single-key-description key)
  89. ;                 (prin1-to-string key nil)))
  90. ;                 (recent-keys)
  91. ;                 " "))
  92.       (save-restriction
  93.         (narrow-to-region before-keys (point))
  94.         (goto-char before-keys)
  95.         (while (progn (move-to-column 50) (not (eobp)))
  96.           (search-forward " " nil t)
  97.           (insert "\n"))))
  98.     (let ((message-buf (get-buffer-create " *Message-Log*")))
  99.       (if message-buf
  100.           (progn
  101.         (insert "\n\nRecent messages:\n")
  102.         (insert-buffer-substring message-buf
  103.                      (save-excursion
  104.                        (set-buffer message-buf)
  105.                        (goto-char (point-max))
  106.                        (forward-line -10)
  107.                        (point))
  108.                      (save-excursion
  109.                        (set-buffer message-buf)
  110.                        (point-max))))))
  111.     ;; This is so the user has to type something
  112.     ;; in order to send easily.
  113.     ;; XEmacs:  FSF non-abstraction of data?
  114.     ;; (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
  115.     ;; Ghod intended it this way:
  116.     (use-local-map (let ((map (make-sparse-keymap)))
  117.              (set-keymap-parents map (list (current-local-map)))
  118.              map))
  119.     (define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info)
  120.     (with-output-to-temp-buffer "*Bug Help*"
  121.       (princ (substitute-command-keys
  122.           "Type \\[mail-send-and-exit] to send the bug report.\n"))
  123.       (princ (substitute-command-keys
  124.           "Type \\[kill-buffer] RET to cancel (don't send it).\n"))
  125.       (terpri)
  126.       (princ (substitute-command-keys "\
  127. Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section
  128. about when and how to write a bug report, and what information to supply
  129. so that the bug can be fixed.
  130. Type `\\[delete-other-windows]' to remove this window.")))
  131.     ;; Make it less likely people will send empty messages.
  132.     (make-local-variable 'mail-send-hook)
  133.     (add-hook 'mail-send-hook 'report-emacs-bug-hook)
  134.     (save-excursion
  135.       (goto-char (point-max))
  136.       (skip-chars-backward " \t\n")
  137.       (make-local-variable 'report-emacs-bug-orig-text)
  138.       (setq report-emacs-bug-orig-text
  139.         (buffer-substring (point-min) (point))))
  140.     (goto-char user-point))))
  141.  
  142. ;; ;;;###autoload
  143. ;; (defalias 'report-emacs-bug 'report-xemacs-bug)
  144.  
  145. (defun report-emacs-bug-info ()
  146.   "Go to the Info node on reporting Emacs bugs."
  147.   (interactive)
  148.   (info)
  149.   (Info-directory)
  150.   (Info-menu "xemacs")
  151.   (Info-goto-node "Bugs"))
  152.  
  153. (defun report-emacs-bug-hook ()
  154.   (save-excursion
  155.     (goto-char (point-max))
  156.     (skip-chars-backward " \t\n")
  157.     (if (and (= (- (point) (point-min))
  158.         (length report-emacs-bug-orig-text))
  159.          (equal (buffer-substring (point-min) (point))
  160.             report-emacs-bug-orig-text))
  161.     (error "No text entered in bug report"))))
  162.  
  163. (provide 'emacsbug)
  164.  
  165. ;;; emacsbug.el ends here
  166.